(GLOBAL (FUNCTIONS IN-CONTEXT
 		   OBJECT
 		   CFRAME
 		   PUSH-CONTEXT
 		   POP-CONTEXT
 		   SPLICE
 		   FETCHI
 		   FETCHM
 		   REALIZE
 		   UNREALIZE
 		   REAL
 		   UNREAL
 		   ACTUALIZE
 		   UNACTUALIZE
 		   DPUTCF
 		   DGETCF
 		   DREMCF
 		   DPUT
 		   DGET
 		   DREM
 		   DPUT+
 		   DGET+
 		   DREM+
 		   PRESENT
 		   ABSENT
 		   DATUM
 		   MENTIONERS
 		   C-MARKER
 		   !⊗
 		   IF-NEEDED
 		   IF-ADDED
 		   IF-REMOVED
 		   DATA-INIT
 		   FETCH
 		   ADD
 		   REMOVE
 		   INSERT
 		   KILL
 		   FLUSH
 		   NEW-CONTEXT
 		   PATH)
	(RESERVED ! !! !? !/, !@ *CONTEXT DATUM *CFRAME GLOBAL *OBJECT CONTEXT *ITEM *METHOD *IGNORE))

(DECLARE (SPECIAL CFRAMES
 		  CNUM
 		  CONTEXT
 		  DATUM
 		  CMARKERS
 		  TYPE
 		  PATTERN
 		  GLOBAL
 		  INCCON
 		  NUMACT
 		  NUMCON
 		  *CNUM
 		  *IF-ADDEDS
 		  *IF-NEEDEDS
 		  *IF-REMOVEDS
 		  *INDEXTHRESHOLD
 		  *ITEMS
 		  NEW)
	 (*FEXPR !⊗ CDEFUN CERR CSETQ : /, GCCON IF-ADDED IF-NEEDED IF-REMOVED)
	 (*LEXPR BIND
 		 ABSENT
 		 ADD
 		 CEVAL
 		 CFRAME
 		 CSET
 		 DGET
 		 DGET+
 		 DPUT
 		 DPUT+
 		 DREM
 		 DREM+
 		 FETCH
 		 FETCHI
 		 FETCHM
 		 INSERT
 		 KILL
 		 MATCH
 		 NOTE
 		 OBJECT
 		 POP-CONTEXT
 		 PRESENT
 		 DATA-INIT
 		 PUSH-CONTEXT
 		 REAL
 		 REALIZE
 		 REMOVE
 		 RVALUE
 		 UNREAL
 		 UNREALIZE)
	 (*EXPR ARGS DATUM CMARKERS PATTERN)
	 (**ARRAY FRAMES RFRAMES))

(SETQ *INDEXTHRESHOLD 12)

(DEFPROP OBJECT (LAMBDA N (LIST (QUOTE *OBJECT) (COND ((= N 0) NIL) ((= N 1) (ARG 1)) ((TMA))))) EXPR)

(DEFPROP TMA (LAMBDA NIL (CERR TOO MANY ARGUMENTS)) EXPR)

(DEFPROP TFA (LAMBDA NIL (CERR TOO FEW ARGUMENTS)) EXPR)

(DECLARE (UNSPECIAL CMARKERS TYPE))

(DEFPROP MAKE-METHOD
	 (LAMBDA(TYPE BOD)
	  (PROG (FIRST OLDM CMARKERS)
		(COND ((ATOM (SETQ FIRST (CAR BOD))) (SETQ CMARKERS
							   (COND
							    ((SETQ OLDM (GET FIRST (QUOTE DATUM)))
							     (CDR (CMARKERS OLDM)))))
						     (PUTPROP FIRST
							      (NCONC (LIST TYPE FIRST (CADR BOD) (CDDR BOD))
 								     CMARKERS)
							      (QUOTE DATUM))
						     (RETURN FIRST))
		      ((RETURN (LIST TYPE NIL FIRST (CDR BOD)))))))
 	 EXPR)

(DECLARE (SPECIAL CMARKERS TYPE))

(DEFPROP IF-NEEDED (LAMBDA (A) (MAKE-METHOD (QUOTE IF-NEEDED) A)) FEXPR)

(DEFPROP IF-ADDED (LAMBDA (A) (MAKE-METHOD (QUOTE IF-ADDED) A)) FEXPR)

(DEFPROP IF-REMOVED (LAMBDA (A) (MAKE-METHOD (QUOTE IF-REMOVED) A)) FEXPR)

(DEFPROP DATA-INIT
	 (LAMBDA K
	  ((LAMBDA(N M)
	    (PROG NIL
		  (COND
		   ((BOUNDP (QUOTE NUMACT))
		    (DO I
 			0
			(/1+ I)
			(= I NUMACT)
			(DO DATA
			    (CDDR (FRAMES I))
			    (CDR DATA)
			    (NULL DATA)
			    ((LAMBDA (D) (AND (ATOM D) (RPLACD (CMARKERS D) NIL))) (CAR DATA))))))
		  (SETQ NUMCON N INCCON M)
		  (ARRAY FRAMES NIL NUMCON)
		  (ARRAY RFRAMES T NUMCON)
		  (STORE (FRAMES 0) (SETQ GLOBAL (LIST (QUOTE *CFRAME) (SETQ *CNUM 0))))
		  (STORE (RFRAMES 0) (CDR GLOBAL))
		  (SETQ CONTEXT (LIST (QUOTE *CONTEXT) GLOBAL))
		  (SETQ NUMACT 1)
		  (PUTPROP (QUOTE ITEM)
			   (SETQ *ITEMS (LIST (QUOTE *LIST) (QUOTE (PATTERN THING)) 0))
			   (QUOTE *INDEX))
		  (PUTPROP (QUOTE IF-NEEDED)
			   (SETQ *IF-NEEDEDS (LIST (QUOTE *LIST) (QUOTE (PATTERN THING)) 0))
			   (QUOTE *INDEX))
		  (PUTPROP (QUOTE IF-ADDED)
			   (SETQ *IF-ADDEDS (LIST (QUOTE *LIST) (QUOTE (PATTERN THING)) 0))
			   (QUOTE *INDEX))
		  (PUTPROP (QUOTE IF-REMOVED)
			   (SETQ *IF-REMOVEDS (LIST (QUOTE *LIST) (QUOTE (PATTERN THING)) 0))
			   (QUOTE *INDEX))
		  (RETURN (SSTATUS INTERRUPT 24 (QUOTE GCCON)))))
	   (COND ((> K 0) (ARG 1)) (T 144))
	   (COND ((> K 1) (ARG 2)) (T 12))))
 	 EXPR)

(DECLARE (UNSPECIAL PATTERN))

(DEFPROP FETCH
	 (LAMBDA N
	  (PROG (PATTERN CON)
		(SETQ PATTERN (ARG 1) CON (GETCONTEXT 1 N))
		(RETURN
		 (CONS (LIST (QUOTE *POSSIBILITIES) PATTERN)
		       (CONS (QUOTE *IGNORE)
			     (NCONC (FETCHI1 PATTERN CON) (FETCHM1 PATTERN *IF-NEEDEDS CON)))))))
 	 EXPR)

(DEFPROP FETCHI
	 (LAMBDA N
	  (CONS (LIST (QUOTE *POSSIBILITIES) (ARG 1))
		(CONS (QUOTE *IGNORE) (FETCHI1 (ARG 1) (GETCONTEXT 1 N)))))
 	 EXPR)

(DEFPROP FETCHM
	 (LAMBDA N
	  (PROG NIL
		(COND ((> N 3) (TMA)))
		(RETURN
		 ((LAMBDA(CON)
		   (CONS (LIST (QUOTE *POSSIBILITIES) (ARG 1))
			 (CONS (QUOTE *IGNORE)
			       (FETCHM1 (ARG 1)
					(COND ((< N 2) *IF-NEEDEDS) ((GET (ARG 2) (QUOTE *INDEX))))
 					CON))))
		  (COND ((< N 3) (/, CONTEXT)) ((ARG 3)))))))
 	 EXPR)

(DEFPROP FETCHI1
	 (LAMBDA(PATTERN CON)
	  (PROG (ALISTS)
		(RETURN
		 (MAPCAN (QUOTE
			  (LAMBDA(ITEM)
			   (COND
			    ((SETQ ALISTS (MATCH PATTERN (CAR ITEM)))
			     (LIST (LIST (QUOTE *ITEM) ITEM (CAR ALISTS)))))))
			 (SEARCH *ITEMS PATTERN T (CDR CON))))))
 	 EXPR)

(DEFPROP FETCHM1
	 (LAMBDA(PATTERN INDEX CON)
	  (MAPCAN (QUOTE
		   (LAMBDA(METHOD)
		    ((LAMBDA (MRESULT) (COND (MRESULT (LIST (CONS (QUOTE *METHOD) (CONS METHOD MRESULT))))))
		     (MATCH (PATTERN METHOD) PATTERN))))
		  (SEARCH INDEX PATTERN NIL (CDR CON))))
 	 EXPR)

(DECLARE (SPECIAL PATTERN))

(DEFPROP REAL (LAMBDA N (AND (REALITY (ARG 1) (GETCONTEXT 1 N)) (ARG 1))) EXPR)

(DEFPROP UNREAL (LAMBDA N (AND (NOT (REALITY (ARG 1) (GETCONTEXT 1 N))) (ARG 1))) EXPR)

(DEFPROP PRESENT
	 (LAMBDA N
	  (PROG (CON PAT CANDIDATES ALISTS)
		(SETQ PAT (ARG 1) CON (GETCONTEXT 1 N) CANDIDATES (SEARCH *ITEMS PAT T (CDR CON)))
 	   LOOP (COND ((NULL CANDIDATES) (RETURN NIL))
		      ((SETQ ALISTS (MATCH PAT (ITEM (CAR CANDIDATES))))
		       (MAPC (QUOTE (LAMBDA (PAIR) (CSET (CAR PAIR) (CADR PAIR)))) (CAR ALISTS))
		       (RETURN (CAR CANDIDATES))))
		(SETQ CANDIDATES (CDR CANDIDATES))
		(GO LOOP)))
 	 EXPR)

(DEFPROP ABSENT (LAMBDA N (UNREAL (DATUM (ARG 1)) (GETCONTEXT 1 N))) EXPR)

(DECLARE (UNSPECIAL PATTERN))

(DEFPROP SEARCH
	 (LAMBDA(INDEX PATTERN ITEM CON)
	  (MAPCAN (QUOTE (LAMBDA (THING) (COND ((REALITY1 (CDR (CMARKERS THING)) CON) (LIST THING)))))
		  (ISEARCH INDEX PATTERN ITEM)))
 	 EXPR)

(DECLARE (SPECIAL PATTERN))

(DEFPROP REALITY (LAMBDA (DATUM CON) (REALITY1 (CDR (CMARKERS DATUM)) (CDR CON))) EXPR)

(DEFPROP REALITY1
	 (LAMBDA(CMARKERS CFRAMES)
	  (PROG (CM CON)
		(SETQ CON CFRAMES)
 	   LOOP (COND ((SETQ CM (MFINTERSECT)) (OR (INVISIBLE (CADR CM) CON) (RETURN CM))
					       (SETQ CMARKERS (CDR CMARKERS) CFRAMES (CDR CFRAMES))
					       (GO LOOP))
		      ((RETURN NIL)))))
 	 EXPR)

(DEFPROP DATUM
	 (LAMBDA(SKELETON)
	  (PROG (CANDIDATES)
		(SETQ CANDIDATES (ISEARCH *ITEMS SKELETON T))
 	   LOOP (COND ((NULL CANDIDATES) (RETURN (LIST SKELETON)))
		      ((EQUAL (ITEM (CAR CANDIDATES)) SKELETON) (RETURN (CAR CANDIDATES))))
		(SETQ CANDIDATES (CDR CANDIDATES))
		(GO LOOP)))
 	 EXPR)

(DEFPROP ADD (LAMBDA N (REALIZE (DATUMIZE (ARG 1)) (GETCONTEXT 1 N))) EXPR)

(CDEFUN ADD (THING ⊗OPTIONAL⊗ (CONTEXT CONTEXT)) (REALIZE (/@ DATUMIZE (/, THING)) CONTEXT))

(DEFPROP REMOVE (LAMBDA N (UNREALIZE (DATUMIZE (ARG 1)) (GETCONTEXT 1 N))) EXPR)

(CDEFUN REMOVE (THING ⊗OPTIONAL⊗ (CONTEXT CONTEXT)) (UNREALIZE (/@ DATUMIZE (/, THING)) CONTEXT))

(DEFPROP INSERT
	 (LAMBDA N ((LAMBDA (D) (PROG NIL (REVEAL D (GETCONTEXT 1 N)) (RETURN D))) (DATUMIZE (ARG 1))))
 	 EXPR)

(DEFPROP KILL
	 (LAMBDA N ((LAMBDA (D) (PROG NIL (HIDE D (GETCONTEXT 1 N)) (RETURN D))) (DATUMIZE (ARG 1))))
 	 EXPR)

(DEFPROP ACTUALIZE (LAMBDA N (PROG NIL (REVEAL (ARG 1) (GETCONTEXT 1 N)) (RETURN (ARG 1)))) EXPR)

(DEFPROP UNACTUALIZE (LAMBDA N (PROG NIL (HIDE (ARG 1) (GETCONTEXT 1 N)) (RETURN (ARG 1)))) EXPR)

(DECLARE (UNSPECIAL DATUM) (SPECIAL PAT CON))

(DEFPROP REALIZE
	 (LAMBDA N
	  (PROG (DATUM CON PAT)
		(SETQ DATUM (ARG 1) CON (GETCONTEXT 1 N))
		(COND
		 ((AND (REVEAL DATUM CON) (SETQ PAT (ITEM DATUM)))
		  (CEVAL (QUOTE (CALLDEMONS (/@ . PAT) (/@ . *IF-ADDEDS) (/@ . CON))))))
		(RETURN DATUM)))
 	 EXPR)

(CDEFUN REALIZE
	(DATUM ⊗OPTIONAL⊗ (CONTEXT CONTEXT))
        ⊗AUX⊗
	(PAT)
	(COND
	 ((/@ AND (REVEAL (/, DATUM) (/, CONTEXT)) (CSETQ PAT (ITEM (/, DATUM))))
	  (CALLDEMONS PAT (/@ . *IF-ADDEDS) CONTEXT)))
        DATUM)

(DEFPROP UNREALIZE
	 (LAMBDA N
	  (PROG (DATUM CON PAT)
		(SETQ DATUM (ARG 1) CON (GETCONTEXT 1 N))
		(COND
		 ((AND (HIDE DATUM CON) (SETQ PAT (ITEM DATUM)))
		  (CEVAL (QUOTE (CALLDEMONS (/@ . PAT) (/@ . *IF-REMOVEDS) (/@ . CON))))))
		(RETURN DATUM)))
 	 EXPR)

(CDEFUN UNREALIZE
	(DATUM ⊗OPTIONAL⊗ (CONTEXT CONTEXT))
        ⊗AUX⊗
	(PAT)
	(COND
	 ((/@ AND (HIDE (/, DATUM) (/, CONTEXT)) (CSETQ PAT (ITEM (/, DATUM))))
	  (CALLDEMONS PAT (/@ . *IF-REMOVEDS) CONTEXT)))
        DATUM)

(DECLARE (SPECIAL DATUM) (UNSPECIAL PAT CON))

(CDEFUN CALLDEMONS
	(PAT INDEX CONTEXT)
        ⊗AUX⊗
	(M)
	(/@ CSETQ M (SEARCH (/, INDEX) (/, PAT) NIL (CDR (/, CONTEXT))))
	(: TLP)
	(COND (M (INVOKE (/@ CAR (/, M)) PAT) (/@ CSETQ M (CDR (/, M))) (GO (QUOTE TLP)))))

(DEFPROP REVEAL
	 (LAMBDA(DATUM CON)
	  (PROG (CM STATUS CMARKERS CFRAMES PATTERN CNUM CFRAME NEW TYPE NUM)
		(SETQ CMARKERS
		      (ANALYZE DATUM)
 		      CFRAMES
		      (SETQ CON (CDR CON))
 		      CM
		      (ADDCFRAME (SETQ CFRAME (CAR CON)) CMARKERS)
 		      CNUM
		      (CADR CFRAME)
 		      STATUS
		      (CADR CM))
		(RPLACA (CDR CM) (QUOTE /+))
		(COND (STATUS (RETURN NIL))
		      ((AND PATTERN NEW (NULL (CDDR CMARKERS)))
		       (INDEX DATUM PATTERN (GET TYPE (QUOTE *INDEX)))))
		(SETQ CMARKERS (CDDR CMARKERS) CFRAMES (CDR CFRAMES))
 	   LOOP (COND
		 ((SETQ CM (MFINTERSECT))
		  (COND ((SETQ NUM (INVISIBLE (CADR CM) CON))
			 (COND
			  ((EQUAL CNUM NUM) (SETQ NEW NIL)
					    (RPLACA (CDR CM) (OR (DELETE CNUM (CADR CM) 1) (QUOTE /+))))))
			((SETQ STATUS T)))
		  (SETQ CMARKERS (CDR CMARKERS) CFRAMES (CDR CFRAMES))
		  (GO LOOP))
		 (NEW (RPLACD (CDR CFRAME) (CONS DATUM (CDDR CFRAME)))))
		(RETURN (NOT STATUS))))
 	 EXPR)

(DEFPROP HIDE
	 (LAMBDA(DATUM CON)
	  (PROG (PATTERN CFRAMES CMARKERS CNUM STATUS NUM TYPE REM OLD CFRAME CM)
		(SETQ CFRAMES (SETQ CON (CDR CON)) CMARKERS (ANALYZE DATUM) CNUM (CADAR CON))
		(COND
		 ((SETQ CM (FINDCFRAME (SETQ CFRAME (CAR CFRAMES)) (CDR CMARKERS)))
		  (SETQ STATUS (CADR CM) OLD T)
		  (COND ((CDDR CM) (RPLACA (CDR CM) NIL))
			((SETQ REM T) (DELQ CM CMARKERS 1)
				      (AND PATTERN
					   (NULL (CDR CMARKERS))
					   (UNINDEX DATUM
 						    PATTERN
						    (GET TYPE (QUOTE *INDEX))
						    (EQ TYPE (QUOTE ITEM))))))))
		(SETQ CMARKERS (CDR CMARKERS))
 	   LOOP (COND
		 ((SETQ CM (MFINTERSECT))
		  (COND ((SETQ NUM (INVISIBLE (CADR CM) CON))
			 (COND (REM (SETQ REM (NOT (EQUAL CNUM NUM)))) ((OR OLD (SETQ OLD (EQUAL CNUM NUM))))))
			((SETQ REM NIL STATUS T) (CANCEL CM CNUM)))
		  (SETQ CMARKERS (CDR CMARKERS) CFRAMES (CDR CFRAMES))
		  (GO LOOP))
		 (REM (RPLACD (CDR CFRAME) (DELQ DATUM (CDDR CFRAME) 1)))
		 ((AND STATUS (NOT OLD)) (RPLACD (CDR CFRAME) (CONS DATUM (CDDR CFRAME)))))
		(RETURN STATUS)))
 	 EXPR)

(DEFPROP ADDCFRAME
	 (LAMBDA(CFRAME CMARKERS)
	  (PROG (N)
		(SETQ N (CADR CFRAME))
 	   LOOP (COND ((OR (NULL (CDR CMARKERS)) (LESSP (CAADR CMARKERS) N)) (RPLACD CMARKERS
										     (CONS
										      (LIST N NIL)
										      (CDR CMARKERS)))
									     (SETQ NEW T))
		      ((EQ N (CAADR CMARKERS)))
		      (T (SETQ CMARKERS (CDR CMARKERS)) (GO LOOP)))
		(RETURN (CADR CMARKERS))))
 	 EXPR)

(DEFPROP FINDCFRAME
	 (LAMBDA(CFRAME CMARKERS)
	  (PROG (NF NM)
		(SETQ NF (CADR CFRAME))
 	   LOOP (COND ((NULL CMARKERS) (RETURN NIL))
		      ((> NF (SETQ NM (CAAR CMARKERS))) (RETURN NIL))
		      ((> NM NF) (SETQ CMARKERS (CDR CMARKERS)) (GO LOOP))
		      ((RETURN (CAR CMARKERS))))))
 	 EXPR)

(DEFPROP CANCEL (LAMBDA (CM NUM) (RPLACA (CDR CM) (MERGEN NUM (CADR CM)))) EXPR)

(DEFPROP MERGEN
	 (LAMBDA(N NL)
	  (COND ((ATOM NL) (LIST N)) ((> N (CAR NL)) (CONS N NL)) ((RPLACD NL (MERGEN N (CDR NL))))))
 	 EXPR)

(DEFPROP DPUTCF
	 (LAMBDA(DATUM PROPERTY INDICATOR CFRAME)
	  (PROG (PATTERN TYPE CM TAIL NEW)
		(SETQ TAIL (ANALYZE DATUM) CM (ADDCFRAME CFRAME TAIL))
		(COND
		 (NEW (RPLACD (CDR CFRAME) (CONS DATUM (CDDR CFRAME)))
		      (AND PATTERN (NULL (CDDR TAIL)) (INDEX DATUM PATTERN (GET TYPE (QUOTE *INDEX))))))
		(RETURN (DPUT1 CM PROPERTY INDICATOR))))
 	 EXPR)

(DEFPROP DGETCF
	 (LAMBDA (DATUM INDICATOR CFRAME) (ASSQ INDICATOR (FINDCFRAME CFRAME (CDR (CMARKERS DATUM)))))
 	 EXPR)

(DEFPROP DREMCF
	 (LAMBDA(DATUM INDICATOR CFRAME)
	  (PROG (CMARKERS PATTERN TYPE CM PAIR)
		(SETQ CMARKERS (ANALYZE DATUM) CM (FINDCFRAME CFRAME (CDR CMARKERS)))
		(COND
		 ((AND CM (SETQ PAIR (ASSQ INDICATOR (CDDR CM)))) (DELQ PAIR (CDR CM) 1)
								  (COND
								   ((NOT (OR (CADR CM) (CDDR CM)))
								    (DELQ CM CMARKERS 1)
								    (DELQ DATUM CFRAME 1)))
								  (COND
								   ((AND PATTERN (NULL (CDR CMARKERS)))
								    (UNINDEX DATUM
 									     PATTERN
									     (GET TYPE (QUOTE *INDEX))
									     (EQ TYPE (QUOTE ITEM)))))
								  (RETURN PAIR)))))
 	 EXPR)

(DEFPROP DPUT (LAMBDA N (DPUTCF (ARG 1) (ARG 2) (ARG 3) (CADR (GETCONTEXT 3 N)))) EXPR)

(DEFPROP DGET
	 (LAMBDA N
	  ((LAMBDA (CONTEXT) (DGET1 (CDR (CMARKERS (ARG 1))) (ARG 2) (CDR CONTEXT) NIL)) (GETCONTEXT 2 N)))
 	 EXPR)

(DEFPROP DREM (LAMBDA N (DREM1 (ARG 1) (ARG 2) (CDR (GETCONTEXT 2 N)) NIL)) EXPR)

(DEFPROP DPUT+
	 (LAMBDA N
	  ((LAMBDA (CM) (COND (CM (DPUT1 CM (ARG 2) (ARG 3))) ((CERR ABSENT DATUM))))
	   (REALITY (ARG 1) (GETCONTEXT 3 N))))
 	 EXPR)

(DEFPROP DGET+ (LAMBDA N (DGET1 (CDR (CMARKERS (ARG 1))) (ARG 2) (CDR (GETCONTEXT 2 N)) T)) EXPR)

(DEFPROP DREM+ (LAMBDA N (DREM1 (ARG 1) (ARG 2) (CDR (GETCONTEXT 2 N)) T)) EXPR)

(DEFPROP DPUT1
	 (LAMBDA(CM PROPERTY INDICATOR)
	  (PROG (PAIR)
		(COND ((SETQ PAIR (ASSQ INDICATOR (CDDR CM))) (RPLACA (CDR PAIR) PROPERTY))
		      ((RPLACD (CDR CM) (CONS (SETQ PAIR (LIST INDICATOR PROPERTY)) (CDDR CM)))))
		(RETURN PAIR)))
 	 EXPR)

(DEFPROP DGET1
	 (LAMBDA(CMARKERS INDICATOR CFRAMES SIGN)
	  (PROG (PAIR CM CON)
		(SETQ CON CFRAMES)
 	   LOOP (COND ((NULL (SETQ CM (MFINTERSECT))) (RETURN NIL))
		      ((AND SIGN (INVISIBLE (CADR CM) CON)))
		      ((SETQ PAIR (ASSQ INDICATOR (CDDR CM))) (RETURN PAIR)))
		(SETQ CMARKERS (CDR CMARKERS) CFRAMES (CDR CFRAMES))
		(GO LOOP)))
 	 EXPR)

(DEFPROP DREM1
	 (LAMBDA(DATUM INDICATOR CFRAMES SIGN)
	  (PROG (PAIR CMARKERS TAIL PATTERN TYPE CM CON)
		(SETQ CON CFRAMES CMARKERS (CDR (SETQ TAIL (ANALYZE DATUM))))
 	   LOOP (COND ((NULL (SETQ CM (MFINTERSECT))) (RETURN NIL))
		      ((AND SIGN (INVISIBLE (CADR CM) CON)))
		      ((SETQ PAIR (ASSQ INDICATOR (CDDR CM))) (DELQ PAIR (CDR CM))
							      (COND
							       ((NOT (OR (CADR CM) (CDDR CM)))
								(DELQ CM TAIL)
								(DELQ DATUM (CAR CFRAMES))))
							      (COND
							       ((AND PATTERN (NULL (CDR TAIL)))
								(UNINDEX DATUM
 									 PATTERN
									 (GET TYPE (QUOTE *INDEX))
									 (EQ TYPE (QUOTE ITEM)))))
							      (RETURN PAIR)))
		(SETQ CMARKERS (CDR CMARKERS) CFRAMES (CDR CFRAMES))
		(GO LOOP)))
 	 EXPR)

(DEFPROP MENTIONERS
	 (LAMBDA N
	  (PROG (CFRAMES CMARKERS MENTIONERS SIGN CM CON)
		(COND ((< N 1) (TFA)))
		(SETQ CFRAMES
		      (CDR (COND ((< N 3) (/, CONTEXT)) ((= N 3) (ARG 3)) ((TMA))))
 		      SIGN
		      (COND ((> N 1) (ARG 2)))
 		      CMARKERS
		      (CDR (CMARKERS (ARG 1)))
 		      CON
 		      CFRAMES)
 	   LOOP (COND
		 ((SETQ CM (MFINTERSECT)) (OR (AND SIGN (INVISIBLE (CADR CM) CON))
					      (SETQ MENTIONERS (CONS (CAR CFRAMES) MENTIONERS)))
					  (SETQ CFRAMES (CDR CFRAMES) CMARKERS (CDR CMARKERS))
					  (GO LOOP)))
		(RETURN (REVERSE MENTIONERS))))
 	 EXPR)

(DECLARE (UNSPECIAL DATUM))

(DEFPROP C-MARKER (LAMBDA (DATUM CFRAME) (FINDCFRAME CFRAME (CDR (CMARKERS DATUM)))) EXPR)

(DECLARE (SPECIAL DATUM))

(DEFPROP MFINTERSECT
	 (LAMBDA NIL
	  (PROG (NM NF CM)
 	   ADVANCE
		(COND ((AND CMARKERS CFRAMES) (SETQ NF (CADAR CFRAMES) CM (CAR CMARKERS) NM (CAR CM)))
		      ((RETURN NIL)))
 	   TEST (COND ((> NF NM) (OR (SETQ CFRAMES (CDR CFRAMES)) (RETURN NIL))
				 (SETQ NF (CADAR CFRAMES))
				 (GO TEST))
		      ((> NM NF) (OR (SETQ CMARKERS (CDR CMARKERS)) (RETURN NIL))
				 (SETQ CM (CAR CMARKERS) NM (CAR CM))
				 (GO TEST))
		      ((RETURN CM)))))
 	 EXPR)

(DECLARE (UNSPECIAL CMARKERS))

(DEFPROP INVISIBLE
	 (LAMBDA(CNUMS CFRAMES)
	  (AND (NOT (EQ CNUMS (QUOTE /+)))
	       (OR (NULL CNUMS)
		   (PROG (NC NF)
			 (SETQ NC (CAR CNUMS))
 		    LOOP (COND (CFRAMES (SETQ NF (CADAR CFRAMES) CFRAMES (CDR CFRAMES))) ((RETURN NIL)))
 		    TEST (COND ((> NF NC) (GO LOOP))
			       ((> NC NF) (OR (SETQ CNUMS (CDR CNUMS)) (RETURN NIL))
					  (SETQ NC (CAR CNUMS))
					  (GO TEST))
			       ((RETURN NC)))))))
 	 EXPR)

(DECLARE (UNSPECIAL CFRAMES))

(DEFPROP GETCONTEXT
	 (LAMBDA (K N) (COND ((< N K) (TFA)) ((= N K) (/, CONTEXT)) ((= N (SETQ K (/1+ K))) (ARG K)) ((TMA))))
 	 EXPR)

(DECLARE (UNSPECIAL PATTERN))

(DEFPROP ISEARCH (LAMBDA (INDEX PATTERN ITEM) (APPLY (QUOTE APPEND) (CDR (ISEARCH1 INDEX PATTERN ITEM)))) EXPR)

(DEFPROP ISEARCH1
	 (LAMBDA(INDEX PATTERN ITEM)
	  (PROG (ASCAR ASCDR)
		(COND ((NULL INDEX) (RETURN (LIST 0)))
		      ((EQ (CAR INDEX) (QUOTE *LIST)) (RETURN (CONS (CADDR INDEX) (LIST (CDDDR INDEX)))))
		      ((EQ (CAR INDEX) (QUOTE *INDEX)))
		      (T (BREAK BAD-STRUCTURE-INDEX--ISEARCH T)))
		(RETURN
		 (COND
		  ((OR (ZEROP (CAR (SETQ ASCAR (ASEARCH (CADDR INDEX) (CAR PATTERN) ITEM))))
		       (NULL (CDR PATTERN))
		       (> (CAR (SETQ ASCDR (ASEARCH (CDDDR INDEX) (CDR PATTERN) ITEM))) (CAR ASCAR)))
		   ASCAR)
		  (ASCDR)))))
 	 EXPR)

(DEFPROP ASEARCH
	 (LAMBDA(SUBINDEX ELEMENT ITEM)
	  (PROG (INDICATOR ASSOCIATION CLLIST VLIST)
		(COND ((EQ (SETQ INDICATOR (ATOMIZE ELEMENT)) (QUOTE *VARIABLE)) (RETURN (LIST 377777777777))))
		(SETQ CLLIST
		      (COND ((EQ INDICATOR (QUOTE *STRUCTURE)) (ISEARCH1 (CAR SUBINDEX) ELEMENT ITEM))
			    ((SETQ ASSOCIATION (ASSQ1 INDICATOR (CDR SUBINDEX)))
			     (CONS (CADR ASSOCIATION) (LIST (CDDR ASSOCIATION))))
			    ((LIST 0))))
		(COND
		 ((AND (NOT ITEM)
		       (SETQ ASSOCIATION (ASSQ (QUOTE *VARIABLE) (CDR SUBINDEX)))
		       (SETQ VLIST (CDDR ASSOCIATION)))
		  (RPLACA CLLIST (/+ (CAR CLLIST) (CADR ASSOCIATION)))
		  (RPLACD CLLIST (CONS VLIST (CDR CLLIST)))))
		(RETURN CLLIST)))
 	 EXPR)

(DEFPROP ASSQ1 (LAMBDA (IND ALIST) (COND ((NUMBERP IND) (ASSOC IND ALIST)) ((ASSQ IND ALIST)))) EXPR)

(DECLARE (SPECIAL THING PFORM INDEX))

(DEFPROP INDEX
	 (LAMBDA(THING PATTERN INDEX)
	  (PROG (NUM THINGS PFORM)
		(COND ((NULL INDEX) (BREAK BAD-INDEX--INDEX T))
		      ((EQ (CAR INDEX) (QUOTE *LIST))
		       (COND
			((EQUAL (SETQ NUM (/1+ (CADDR INDEX))) *INDEXTHRESHOLD) (RPLACA INDEX (QUOTE *INDEX))
										(SETQ THINGS
										      (CDDDR INDEX)
 										      PFORM
										      (CADR INDEX))
										(RPLACD
										 (CDR INDEX)
										 (LIST (LIST NIL) NIL))
										(MAPC
										 (!⊗ LAMBDA
										     (THING)
										     (INDEX
										      THING
										      (/@ . PFORM)
										      INDEX))
										 THINGS))
			(T (RPLACD (CDR INDEX) (CONS NUM (CONS THING (CDDDR INDEX)))) (RETURN THING))))
		      ((EQ (CAR INDEX) (QUOTE *INDEX)) (SETQ PFORM (CADR INDEX)))
		      ((BREAK BAD-INDEX--INDEX T)))
		(INDEX1 THING (CAR PATTERN) (CADDR INDEX) (QUOTE CAR) PFORM)
		(AND (CDR PATTERN) (INDEX1 THING (CDR PATTERN) (CDDDR INDEX) (QUOTE CDR) PFORM))
		(RETURN THING)))
 	 EXPR)

(DECLARE (UNSPECIAL PFORM INDEX))

(DEFPROP UNINDEX
	 (LAMBDA(THING PATTERN INDEX ITEM)
	  (COND ((NULL INDEX) (BREAK BAD-INDEX--UNINDEX T))
		((EQ (CAR INDEX) (QUOTE *LIST)) (RPLACD (CDR INDEX)
							(CONS (/1- (CADDR INDEX))
							      (DELTHING THING (CDDDR INDEX) ITEM)))
 						THING)
		((EQ (CAR INDEX) (QUOTE *INDEX)) (UNINDEX1 THING (CAR PATTERN) (CADDR INDEX) ITEM)
						 (AND (CDR PATTERN)
						      (UNINDEX1 THING (CDR PATTERN) (CDDDR INDEX) ITEM))
 						 THING)
		((BREAK BAD-INDEX--UNINDEX T))))
 	 EXPR)

(DECLARE (UNSPECIAL THING))

(DEFPROP INDEX1
	 (LAMBDA(THING ELEMENT SUBINDEX POS PFORM)
	  (PROG (INDICATOR ASSOCIATION)
		(COND
		 ((EQ (SETQ INDICATOR (ATOMIZE ELEMENT)) (QUOTE *STRUCTURE))
		  (COND ((NULL (CAR SUBINDEX)) (RPLACA SUBINDEX (LIST (QUOTE *LIST) (LIST POS PFORM) 0))))
		  (INDEX THING ELEMENT (CAR SUBINDEX)))
		 ((SETQ ASSOCIATION (ASSQ1 INDICATOR (CDR SUBINDEX)))
		  (RPLACD ASSOCIATION (CONS (/1+ (CADR ASSOCIATION)) (CONS THING (CDDR ASSOCIATION)))))
		 (T (RPLACD SUBINDEX (CONS (LIST INDICATOR 1 THING) (CDR SUBINDEX)))))))
 	 EXPR)

(DEFPROP UNINDEX1
	 (LAMBDA(THING ELEMENT SUBINDEX ITEM)
	  (PROG (ASSOCIATION INDICATOR NUM)
		(SETQ INDICATOR (ATOMIZE ELEMENT))
		(COND ((EQ INDICATOR (QUOTE *STRUCTURE)) (UNINDEX THING ELEMENT (CAR SUBINDEX) ITEM))
		      ((SETQ ASSOCIATION (ASSQ1 INDICATOR (CDR SUBINDEX)))
		       (COND ((ZEROP (SETQ NUM (/1- (CADR ASSOCIATION)))) (DELQ ASSOCIATION SUBINDEX))
			     (T (RPLACD ASSOCIATION (CONS NUM (DELTHING THING (CDDR ASSOCIATION) ITEM)))))))))
 	 EXPR)

(DECLARE (SPECIAL PATTERN))

(DEFPROP ANALYZE
	 (LAMBDA(X)
	  (COND ((NULL X) (CERR MEANINGLESS DATUM /-- ANALYZE))
		((ATOM X) (ANALYZE (GET X (QUOTE DATUM))))
		((EQ (CAR X) (QUOTE *CLOSURE)) (PROG2 (ANALYZE (CADR X)) (CDDR X) (SETQ DATUM X)))
		((EQ (CAR X) (QUOTE *OBJECT)) (SETQ PATTERN NIL TYPE (QUOTE OBJECT)) (CDR X))
		((ATOM (SETQ TYPE (CAR X))) (SETQ PATTERN (CADDR X))
					    (AND (CADR X) (SETQ DATUM (CADR X)))
					    (CDDDR X))
		(T (SETQ PATTERN (CAR X) TYPE (QUOTE ITEM)) X)))
 	 EXPR)

(DECLARE (UNSPECIAL PATTERN))

(DEFPROP CMARKERS
	 (LAMBDA(DATUM)
	  (COND ((NULL DATUM) (CERR MEANINGLESS DATUM /-- CMARKERS))
		((ATOM DATUM) (CMARKERS (GET DATUM (QUOTE DATUM))))
		((EQ (CAR DATUM) (QUOTE *CLOSURE)) (CDDR DATUM))
		((EQ (CAR DATUM) (QUOTE *OBJECT)) (CDR DATUM))
		((ATOM (CAR DATUM)) (CDDDR DATUM))
		(DATUM)))
 	 EXPR)

(DEFPROP PATTERN
	 (LAMBDA(DATUM)
	  (COND ((NULL DATUM) (CERR MEANINGLESS DATUM /-- PATTERN))
		((ATOM DATUM) (PATTERN (GET DATUM (QUOTE DATUM))))
		((EQ (CAR DATUM) (QUOTE *CLOSURE)) (PATTERN (CADR DATUM)))
		((ATOM (CAR DATUM)) (CADDR DATUM))
		((CAR DATUM))))
 	 EXPR)

(DEFPROP NTH (LAMBDA (EXP N) (COND ((= N 1) (CAR EXP)) ((NTH (CDR EXP) (/1- N))))) EXPR)

(DEFPROP DELTHING
	 (LAMBDA (THING LIST ITEM) (COND (ITEM (DELITEM (ITEM THING) LIST)) ((DELQ THING LIST 1))))
 	 EXPR)

(DEFPROP DELITEM
	 (LAMBDA(EXP LIST)
	  (COND ((NULL LIST) NIL)
		((EQUAL EXP (ITEM (CAR LIST))) (CDR LIST))
		(T (RPLACD LIST (DELITEM EXP (CDR LIST))))))
 	 EXPR)

(DEFPROP MEMCAR
	 (LAMBDA(EXP LIST)
	  (COND ((NULL LIST) NIL) ((EQUAL EXP (ITEM (CAR LIST))) LIST) (T (MEMCAR EXP (CDR LIST)))))
 	 EXPR)

(DEFPROP ITEM
	 (LAMBDA(DATUM)
	  (COND ((NULL DATUM) (CERR MEANINGLESS DATUM))
		((ATOM DATUM) (ITEM (GET DATUM (QUOTE DATUM))))
		(((LAMBDA (PAT) (AND (NOT (ATOM PAT)) PAT)) (CAR DATUM)))))
 	 EXPR)

(DEFPROP DATUMIZE (LAMBDA (THING) (COND ((ATOM THING) THING) ((DATUM THING)))) EXPR)

(DEFPROP ATOMIZE
	 (LAMBDA(ELEMENT)
	  (COND ((ATOM ELEMENT) ELEMENT) ((ACTOR (CAR ELEMENT)) (QUOTE *VARIABLE)) (T (QUOTE *STRUCTURE))))
 	 EXPR)

(DEFPROP PUSH-CONTEXT (LAMBDA N (CONS (QUOTE *CONTEXT) (CONS (CFRAME) (CDR (GETCONTEXT 0 N))))) EXPR)

(DEFPROP POP-CONTEXT (LAMBDA N (CONS (QUOTE *CONTEXT) (CDDR (GETCONTEXT 0 N)))) EXPR)

(DECLARE (UNSPECIAL CFRAMES))

(DEFPROP NEW-CONTEXT
	 (LAMBDA(CFRAMES)
	  (COND ((ORDERED CFRAMES) (CONS (QUOTE *CONTEXT) CFRAMES)) ((CERR UNORDERED CONTEXT))))
 	 EXPR)

(DECLARE (SPECIAL CFRAMES))

(DEFPROP SPLICE
	 (LAMBDA(CONTEXT)
	  (PROG NIL
		(RPLACD (CDR CONTEXT)
			(CONS (CFRAME (NEWCNUM (CADR (CADDR CONTEXT)) (CADADR CONTEXT))) (CDDR CONTEXT)))
		(RETURN CONTEXT)))
 	 EXPR)

(DECLARE (SPECIAL EXPR))

(DEFPROP IN-CONTEXT
	 (LAMBDA (CONTEXT EXPR) (CEVAL (QUOTE ((CLAMBDA (CONTEXT) (CEVAL (/@ . EXPR))) (/@ . CONTEXT)))))
 	 EXPR)

(DECLARE (UNSPECIAL EXPR))

(CDEFUN IN-CONTEXT (CONTEXT EXPR) (CEVAL EXPR))

(DEFPROP PATH (LAMBDA (C) (CONS (QUOTE *CONTEXT) (MAPCAR (QUOTE CADR) (CDR C)))) EXPR)

(DEFPROP CFRAME
	 (LAMBDA K
	  ((LAMBDA(NFRAME)
	    (PROG NIL
		  (COND ((AND (= NUMACT NUMCON) (= (GCCON) NUMCON)) (CERR TOO MANY CONTEXT-FRAMES)))
		  (STORE (FRAMES NUMACT) NFRAME)
		  (STORE (RFRAMES NUMACT) (CDR NFRAME))
		  (SETQ NUMACT (/1+ NUMACT))
		  (RETURN NFRAME)))
	   (LIST (QUOTE *CFRAME) (COND ((ZEROP K) (SETQ *CNUM (/+ INCCON *CNUM))) (T (ARG 1))))))
 	 EXPR)

(DEFPROP ORDERED
	 (LAMBDA(CLIST)
	  (OR (NULL CLIST)
	      (PROG NIL
 	       LOOP (COND
		     ((CDR CLIST) (OR (< (CADADR CLIST) (CADAR CLIST)) (RETURN NIL))
				  (SETQ CLIST (CDR CLIST))
				  (GO LOOP)))
		    (RETURN T))))
 	 EXPR)

(DEFPROP NEWCNUM
	 (LAMBDA(LOW HIGH)
	  (PROG (N INC INUSE)
		(SETQ N (// (/+ LOW HIGH) 2) INUSE (CNUMSINUSE LOW HIGH) INC 1)
 	   LOOP (COND ((GREATERP HIGH N LOW)
		       (COND ((MEMBER N INUSE) (SETQ N (/+ N INC) INC (/- 0 (/1+ INC))) (GO LOOP))
			     ((RETURN N))))
		      ((CERR NO NEW CNUM BETWEEN (* LOW) AND (* HIGH))))))
 	 EXPR)

(DEFPROP CNUMSINUSE
	 (LAMBDA(LOW HIGH)
	  (PROG (I NUMS J N)
		(SETQ I 0 J (/1- NUMACT))
 	   LOOP (COND ((> I J) (RETURN NUMS))
		      ((OR (> LOW (SETQ N (CAR (RFRAMES I)))) (> N HIGH)))
		      ((SETQ NUMS (CONS N NUMS))))
		(SETQ I (/1+ I))
		(GO LOOP)))
 	 EXPR)

(DEFPROP *GCCON
	 (LAMBDA NIL
	  (PROG (M N)
		(SETQ N 0 M NUMACT)
 	   NGCLP
		(COND ((= M N) (RETURN N)) ((EQ (CDR (FRAMES N)) (RFRAMES N)) (SETQ N (/1+ N)) (GO NGCLP)))
		(FLUSH (RFRAMES N))
		(STORE (RFRAMES N) 0)
 	   MGCLP
		(SETQ M (/1- M))
		(COND ((= M N) (RETURN N)) ((EQ (CDR (FRAMES M)) (RFRAMES M)) (GO EXCH)))
		(FLUSH (RFRAMES M))
		(STORE (RFRAMES M) 0)
		(GO MGCLP)
 	   EXCH (STORE (FRAMES N) (FRAMES M))
		(STORE (RFRAMES N) (RFRAMES M))
		(STORE (RFRAMES M) 0)
		(GO NGCLP)))
 	 EXPR)

(DEFPROP GCCON (LAMBDA (L) (SETQ NUMACT (*GCCON))) FEXPR)

(DECLARE (SPECIAL PATTERN))

(DEFPROP FLUSH
	 (LAMBDA(CFRAME)
	  (PROG (THING THINGS N PATTERN TYPE CMARKERS)
		(SETQ THINGS (CDR CFRAME) N (CAR CFRAME))
 	   LOOP (COND ((NULL THINGS) (RETURN NIL)))
		(COND
		 ((AND (REMCFRAME N (SETQ CMARKERS (ANALYZE (SETQ THING (CAR THINGS)))))
 		       PATTERN
		       (NULL (CDR CMARKERS)))
		  (UNINDEX THING PATTERN (GET TYPE (QUOTE *INDEX)) (EQ TYPE (QUOTE ITEM)))))
		(SETQ THINGS (CDR THINGS))
		(GO LOOP)))
 	 EXPR)

(DECLARE (UNSPECIAL PATTERN))

(DEFPROP REMCFRAME
	 (LAMBDA(N CMARKERS)
	  (PROG (M CM)
 	   LOOP1
		(COND ((NULL (CDR CMARKERS)) (RETURN NIL))
		      ((= N (SETQ M (CAADR CMARKERS))) (RPLACD CMARKERS (CDDR CMARKERS)) (RETURN T))
		      ((> N M) (SETQ CMARKERS (CDR CMARKERS)) (GO LOOP1)))
 	   LOOP2
		(SETQ CMARKERS (CDR CMARKERS))
		(COND ((NULL CMARKERS) (RETURN NIL))
		      ((ATOM (CADR (SETQ CM (CAR CMARKERS))))
		       (AND (MEMBER N (CADR CM)) (RPLACA (CDR CM) (OR (DELETE N (CADR CM) 1) (QUOTE /+))))))
		(GO LOOP2)))
 	 EXPR)

(DEFPROP !⊗ (LAMBDA (L) (!⊗1 L)) FEXPR)